Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/center2g/modperfo.bas

BASIC Source File | 1999-09-01 | 13KB | 358 lines

Attribute VB_Name = "modPerformanceAPI"
Option Explicit
Public StopSampling As Boolean
Public hQuery As Long
Public CounterIndex As Integer
Public header(50) As String

Type CounterElement
    hCounter As Long
    dwType As Long
    CVersion As Long
    CStatus As Long
    lScale As Long
    lDefaultScale As Long
    dwUserData As Long
    dwQueryUserData As Long
    szFullPath As String
    szMachineName As String
    szObjectName As String
    szInstanceName As String
    szParentInstance As String
    dwInstanceIndex As Long
    szCounterName As String
    szExplainText As String
    CounterValue As Double
End Type
Public CounterTable(255) As CounterElement
Public PdhLastError As String
Public PdhLastCounterPath As String

'Multi Purpose Declares
Private Declare Function PtrToStrA Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Performance Data Helper - Constants
' dwFormat flag values
Public Const PDH_FMT_RAW = &H10
Public Const PDH_FMT_ANSI = &H20
Public Const PDH_FMT_UNICODE = &H40
Public Const PDH_FMT_LONG = &H100
Public Const PDH_FMT_DOUBLE = &H200
Public Const PDH_FMT_LARGE = &H400
Public Const PDH_FMT_NOSCALE = &H1000
Public Const PDH_FMT_1000 = &H2000
Public Const PDH_FMT_NODATA = &H4000

' DetailLevel flag values
Public Const PERF_DETAIL_NOVICE& = 100         ' The uninformed can understand it
Public Const PERF_DETAIL_ADVANCED& = 200       ' For the advanced user
Public Const PERF_DETAIL_EXPERT& = 300         ' For the expert user
Public Const PERF_DETAIL_WIZARD& = 400         ' For the system designer

'Performance Data Helper - Types
Type PDH_COUNTER_INFO
    dwLength As Long
    dwType As Long
    CVersion As Long
    CStatus As Long
    lScale As Long
    lDefaultScale As Long
    dwUserData As Long
    dwQueryUserData As Long
    szFullPath As Long
    szMachineName As Long
    szObjectName As Long
    szInstanceName As Long
    szParentInstance As Long
    dwInstanceIndex As Long
    szCounterName As Long
    lpNull As Long
    szExplainText As Long
    DataBuffer(16) As Long
End Type

'Performance Data Helper - Functions
Private Declare Function PdhOpenQuery Lib "pdh.dll" Alias "PdhVbOpenQuery" (hQuery As Long) As Long
Private Declare Function PdhAddCounter Lib "pdh.dll" Alias "PdhVbAddCounter" (ByVal hQuery As Long, ByVal szFullCounterPath As String, hCounter As Long) As Long
Private Declare Function PdhRemoveCounter Lib "pdh.dll" (ByVal hCounter As Long) As Long
Private Declare Function PdhCollectQueryData Lib "pdh.dll" (ByVal hQuery As Long) As Long
Private Declare Function PdhGetDoubleCounterValue Lib "pdh.dll" Alias "PdhVbGetDoubleCounterValue" (ByVal CounterHandle As Long, ByRef CounterStatus As Long) As Double
Private Declare Function PdhCloseQuery Lib "pdh.dll" (ByVal hQuery As Long) As Long
Private Declare Function PdhIsGoodStatus Lib "pdh.dll" Alias "PdhVbIsGoodStatus" (ByVal StatusValue As Long) As Long
Private Declare Function PdhCreateCounterPathList Lib "pdh.dll" Alias "PdhVbCreateCounterPathList" (ByVal DetailLevel As Long, ByVal CaptionString As String) As Long
Private Declare Function PdhGetOneCounterPath Lib "pdh.dll" Alias "PdhVbGetOneCounterPath" (ByVal PathString As String, ByVal PathLength As Long, ByVal DetailLevel As Long, ByVal CaptionString As String) As Long
Private Declare Function PdhGetCounterPathFromList Lib "pdh.dll" Alias "PdhVbGetCounterPathFromList" (ByVal Index As Long, ByVal Buffer As String, ByVal BufferLength As Long) As Long
Private Declare Function PdhGetCounterInfo Lib "pdh.dll" Alias "PdhGetCounterInfoA" (ByVal hCounter As Long, ByVal bRetrieveExplainText As Long, pdwBufferSize As Long, lpBuffer As Long) As Long
Sub AddComputer(ByVal ComputerName As String)
    Set ItmX = frmPerfExplorer.ListView.ListItems.Add(, "P" & CounterIndex - 1, ComputerName)
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Errors During Script Runtime"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Errors From ASP Preprocessor"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Errors From Script Compilers"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Memory Allocated"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Request Bytes In Total"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Request Bytes Out Total"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Requests Failed Total"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Requests Succeeded"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Requests Timed Out"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Sessions Current"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Sessions Total"
        'AddCounter "\\" & ComputerName & "\Active Server Pages\Template Cache Hit Rate"
    '******************CPU
     AddCounter "\\" & ComputerName & "\Processor(0)\% Processor Time"
     AddCounter "\\" & ComputerName & "\Memory\% Committed Bytes In Use"
     AddCounter "\\" & ComputerName & "\System\System Up Time"
    '*******************************Web service
     'AddCounter "\\" & ComputerName & "\Web Service\Bytes Sent/Sec"
     'AddCounter "\\" & ComputerName & "\Web Service\Maximum Connections"
    ' AddCounter "\\" & ComputerName & "\Web Service\Total Connections"
     'AddCounter "\\" & ComputerName & "\Web Service\Total Files Recieved"
     'AddCounter "\\" & ComputerName & "\Web Service\Total Files Sent"
     'AddCounter "\\" & ComputerName & "\Web Service\Total Get Requests"
     'AddCounter "\\" & ComputerName & "\Web Service\Total Post Requests"
     'AddCounter "\\" & ComputerName & "\Web Service\Total ISAPI Extension Requests"
End Sub


Function PdhCounterInfo(ByVal Index As Integer) As Boolean
    Dim X As Long
    Dim lpBuffer() As Long
    Dim pdwBufferSize As Long

    pdwBufferSize = 0
    ReDim lpBuffer(0)
    X = PdhGetCounterInfo(CounterTable(Index).hCounter, True, pdwBufferSize, lpBuffer(0))
    ReDim lpBuffer((pdwBufferSize / 4) + 10)
    X = PdhGetCounterInfo(CounterTable(Index).hCounter, True, pdwBufferSize, lpBuffer(0))
    If PdhIsGoodStatus(X) = 0 Then
        PdhLastError = GetPdhReturn(X)
        PdhCounterInfo = False
    Else
        With CounterTable(Index)
            .dwType = lpBuffer(1)
            .CVersion = lpBuffer(2)
            .CStatus = lpBuffer(3)
            .lScale = lpBuffer(4)
            .lDefaultScale = lpBuffer(5)
            .dwUserData = lpBuffer(6)
            .dwQueryUserData = lpBuffer(7)
            .szFullPath = PointerToString(lpBuffer(8))
            .szMachineName = PointerToString(lpBuffer(9))
            .szObjectName = PointerToString(lpBuffer(10))
            .szInstanceName = PointerToString(lpBuffer(11))
            .szParentInstance = PointerToString(lpBuffer(12))
            .dwInstanceIndex = lpBuffer(13)
            .szCounterName = PointerToString(lpBuffer(14))
            .szExplainText = PointerToString(lpBuffer(16))
        End With
        PdhCounterInfo = True
    End If

    Erase lpBuffer
End Function



Function PdhAdd(ByVal szFullCounterPath As String) As Boolean
    Dim X As Long

    CounterTable(CounterIndex).hCounter = 0
    X = PdhAddCounter(hQuery, szFullCounterPath, CounterTable(CounterIndex).hCounter)
    If PdhIsGoodStatus(X) = 0 Then
        PdhLastError = GetPdhReturn(X)
        PdhAdd = False
    Else
        PdhAdd = True
        CounterIndex = CounterIndex + 1
    End If
End Function

Function PdhCollect() As Boolean
    Dim X As Long

    X = PdhCollectQueryData(hQuery)
    If PdhIsGoodStatus(X) = 0 Then
        PdhLastError = GetPdhReturn(X)
        PdhCollect = False
    Else
        PdhCollect = True
    End If

End Function

Function PdhCounterDialog1(ByVal CaptionString As String) As Boo